home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qlib205.zip / QLIB.ZIP / SRC / MATH / MATH_COM.ASM < prev    next >
Encoding:
Assembly Source File  |  1997-04-13  |  10.4 KB  |  413 lines
  1. ; Math Library to be used in C programs
  2.  
  3. ;after finishing up the new func I found that BC LIBs suck!
  4. ; they had a few bugs, such as INF equal to 1.76645645e308 or so, and
  5. ; reports an error when pow(0,0) is used which returns 1 but should not
  6. ; be an error (at least according to their online help)
  7.  
  8. .data?
  9.   align 4
  10.   result REAL8 ?
  11.   tmpd dd ?
  12.   tmpr real8 ?
  13.   tmpr2 real8 ?
  14.   tmpw dw ?
  15.   sign  db ?
  16.  
  17. .const
  18.   _ZERO real8 0.0
  19.   EXP_MAX real8 709.7827128933839
  20.   ten REAL8 10.0
  21. ;FIX : v2.00 Beta #7 : these were all backwards and messed up
  22.   rnd_0 label word    ;round towards 0
  23.     db 7fh,1111b
  24.   rnd_up label word   ;round up
  25.     db 7fh,1011b
  26.   rnd_dw label word   ;round down
  27.     db 7fh,0111b
  28.   cw_def label word   ;default rounding (to nearest or even)
  29.     db 7fh,0011b 
  30.  
  31. .code
  32. RETURN macro   ;saves return value (on FPU stack) in Watcom or Borland style
  33.   ifdef _WC_
  34.     fstp result
  35.     fwait
  36.     mov eax,dptr[result]
  37.     mov edx,dptr[result+4]
  38.     ret
  39.   else
  40.     fwait
  41.     ret
  42.   endif
  43. endm
  44.  
  45. LOADF macro    ;loads Watcom return into FPU stack
  46.   ifdef _WC_
  47.     mov dptr[result],eax
  48.     mov dptr[result+4],edx
  49.     fld result
  50.     fwait
  51.   endif
  52. endm
  53.  
  54. CHKF macro    ;sets errno based on value on top of FPU stack
  55.   fxam
  56.   fstsw ax
  57.   fwait
  58.   and ah,01000111b
  59.   .if ah == 001b || ah == 011b
  60.     ;+/-NAN
  61.     mov errno,EDOM
  62.   .elseif ah == 101b || ah == 111b
  63.     ;+/-INF
  64.     mov errno,ERANGE
  65.   .endif
  66. endm
  67.  
  68. sin proc,a:REAL8
  69.   fld a
  70.   fsin
  71.   fstsw ax
  72.   .if ax&4  ;mask C2
  73.     mov errno,ERANGE
  74.   .else
  75.     mov errno,0
  76.   .endif
  77.   RETURN
  78. sin endp
  79.  
  80. cos proc,a:REAL8
  81.   fld a
  82.   fcos
  83.   fstsw ax
  84.   .if ax&4  ;mask C2
  85.     mov errno,ERANGE
  86.   .else
  87.     mov errno,0
  88.   .endif
  89.   fwait
  90.   RETURN
  91. cos endp
  92.  
  93. tan proc,a:REAL8
  94.   fld a
  95.   fsincos
  96.   fstsw ax
  97.   .if ax&4  ;mask C2
  98.     mov errno,ERANGE
  99.   .else
  100.     mov errno,0
  101.   .endif
  102.   fdivp st(1),st
  103.   RETURN
  104. tan endp
  105.  
  106. ftol proc,a:REAL8
  107.   fld a
  108. __ftol::
  109.   fistp dptr[result]
  110.   fwait
  111.   mov eax,dptr[result]
  112.   ret
  113. ftol endp
  114.  
  115. f_abs proc,a:REAL8
  116.   and bptr [a+7],7fh
  117.   fld a
  118.   RETURN
  119. f_abs endp
  120.  
  121. ceil proc,a:REAL8
  122.   fldcw rnd_up
  123.   fld a
  124.   frndint
  125.   fldcw cw_def
  126.   RETURN  
  127. ceil endp
  128.  
  129. floor proc,a:REAL8
  130.   fldcw rnd_dw
  131.   fld a
  132.   frndint
  133.   fldcw cw_def
  134.   RETURN
  135. floor endp
  136.  
  137. ;FIX : v2.00 Beta #7 : now supports exp forms
  138. atof proc,a:dword
  139.   local _neg:byte
  140.  
  141.   pushad
  142.   mov esi,a
  143.   mov _neg,0
  144.   fldz
  145.   xor eax,eax  ;keep high part clear
  146. @@:
  147.   lodsb
  148.   .if al==32
  149.     jmp @b
  150.   .endif
  151.   .if al=='-'
  152.     inc _neg
  153.     lodsb
  154.   .endif
  155.   .if al=='e' || al=='E'
  156.     jmp doexp  ; still have to get exp even though 0**anything is zero
  157.   .endif       ;   cause _str2num_siz_ must be updated
  158.   .if al=='.'
  159.     jmp dodec
  160.   .endif
  161. @@:
  162.   .if (al>='0') && (al<='9')
  163.     fmul ten
  164.     sub al,'0'
  165.     mov tmpd,eax
  166.     fiadd tmpd
  167.     fwait
  168.   .elseif al=='.'
  169.     jmp dodec
  170.   .elseif al=='e' || al=='E'
  171.     jmp doexp
  172.   .else
  173.     jmp done
  174.   .endif
  175.   lodsb
  176.   jmp @b
  177. dodec:
  178.   fldz  ;decimal part
  179.   mov edi,esi    ;save EDI for stop pt
  180.   lodsb
  181.   .if ! ( (al>='0') && (al<='9') )
  182.     fstp tmpr  ;ignore!
  183.     fwait
  184.     ;FIX v 2.00 Beta #8 : this was not poped off properly
  185.     .if al=='e' || al=='E'
  186.       jmp doexp
  187.     .endif
  188.     jmp done  ;no numbers after .
  189.   .endif
  190. @@:
  191.   .if (al>='0') && (al<='9')
  192.     lodsb
  193.     jmp @b
  194.   .endif
  195.   push esi
  196.   push ax  ;save last thing (if it's 'e' then there is an exp part)
  197.   dec esi  ;go back
  198.   dec esi  
  199. @@:            ;go until ESI==EDI
  200.   mov al,[esi]
  201.   sub al,'0'
  202.   mov tmpd,eax
  203.   fiadd tmpd
  204.   fdiv ten
  205.   fwait
  206.   .if esi>edi
  207.     dec esi
  208.     jmp @b
  209.   .endif
  210.   faddp st(1),st
  211.   pop ax
  212.   pop esi
  213.   .if !(al=='e' || al=='E')
  214.     jmp done
  215.   .endif
  216. doexp:
  217.   ;esi=>char after e
  218.   .if bptr[esi]=='-'
  219.     mov ch,1
  220.     inc esi
  221.   .else
  222.     mov ch,0
  223.   .endif
  224.   xor eax,eax
  225.   xor ebx,ebx
  226. @@:
  227.   lodsb
  228.   .if !((al >= '0') && (al<= '9'))
  229.     jmp expdone
  230.   .endif
  231.   sub al,'0'
  232.   imul ebx,ebx,10
  233.   add ebx,eax
  234.   jmp @b
  235. expdone:
  236.   fstp tmpr      ;save #
  237.   mov tmpd,ebx
  238.   fild tmpd
  239.   fstp tmpr2
  240.   fwait
  241.   callp pow,ten,tmpr2
  242.   LOADF    ;st(1)
  243.   fld tmpr ;st   ;reload #
  244.   .if ch==1  ;neg
  245.     fxch
  246.     fdivp st(1),st
  247.   .else      ;pos
  248.     fmulp st(1),st
  249.   .endif
  250. done:
  251.   .if _neg
  252.     fchs
  253.   .endif
  254.   mov eax,esi
  255.   sub eax,a
  256.   dec eax  ;minus the last char not used (ie: NULL)
  257.   mov _str2num_siz_,eax  ;FIX : v2.00 Beta #7 : this was not set right
  258.   popad
  259.   RETURN
  260. atof endp
  261.  
  262. exp PROC, val:REAL8
  263.     mov     [errno], 0                          ; clear matherror
  264.     fld     val                                 ; load the value
  265.     fcom    EXP_MAX                             ; exceeded maximum?
  266.     fstsw   ax                                  ; save status word in AX
  267.     fwait                                       ; wait this shit be idle
  268.     sahf                                        ; load flags with it
  269.     jna @f
  270.     mov     [errno], ERANGE                     ; set matherror from QLIB
  271. @@:
  272.     fldl2e                                      ; load log 2 (base e)
  273.     fmulp   st(1), st(0)                        ; mul them
  274.     fld     st(0)                               ; copy st(0) to st(1)
  275.     frndint                                     ; rount st(0)
  276.     fxch    st(1)                               ; xchange st(1) for st(0)
  277.     fsub    st(0), st(1)                        ; sub rounded from unrounded
  278.     f2xm1                                       ; calc 2^x-1
  279.     fld1                                        ; load 1.00
  280.     faddp   st(1), st(0)                        ; add 1.00 to st(1)
  281.     fscale                                      ; exponential function of a
  282.     ffree   st(1)                               ; remove rounded value
  283.     RETURN
  284. exp ENDP
  285.  
  286. log proc, val:REAL8
  287.     mov     [errno], 0                          ; clear matherror
  288.     fld     val                                 ; load the value
  289.     ftst                                        ; compare with zero
  290.     fstsw   ax                                  ; save status word in AX
  291.     fwait                                       ; wait this shit be idle
  292.     sahf                                        ; load flags with it
  293.     .if carry?   ;jb      @@negative                          ; jump if value < 0
  294.       mov     [errno], EDOM                       ; domain error
  295.     .endif
  296.     .if zero?    ;je      @@zero                              ; jump if zero
  297.       mov     [errno], ERANGE                     ; range error
  298.     .endif
  299.  
  300.     fldln2                                      ; load natural log of 2
  301.     fxch    st(1)                               ; xchange it with value
  302.     fyl2x                                       ; calc y=log2(x)
  303.  
  304.     RETURN
  305. log ENDP
  306.  
  307. log10 PROC, val:REAL8
  308.     mov     [errno], 0                          ; clear matherror
  309.     fld     val                                 ; load the value
  310.     ftst                                        ; compare with zero
  311.     fstsw   ax                                  ; save status word in AX
  312.     fwait                                       ; wait this shit be idle
  313.     sahf                                        ; load flags with it
  314.     .if carry?   ;jb      @@negative                          ; jump if value < 0
  315.       mov     [errno], EDOM                       ; domain error
  316.     .endif
  317.     .if zero?    ;je      @@zero                              ; jump if zero
  318.       mov     [errno], ERANGE                     ; range error
  319.     .endif
  320.  
  321.     fldlg2                                      ; load log of 2
  322.     fxch    st(1)                               ; xchange it wih value
  323.     fyl2x                                       ; calc y=log2(x)
  324.     RETURN
  325. log10 ENDP
  326.  
  327. log2 PROC, val:REAL8
  328.     mov     [errno], 0                          ; clear matherror
  329.     fld     val                                 ; load the value
  330.     ftst                                        ; compare with zero
  331.     fstsw   ax                                  ; save status word in AX
  332.     fwait                                       ; wait this shit be idle
  333.     sahf                                        ; load flags with it
  334.     .if carry?   ;jb      @@negative                          ; jump if value < 0
  335.       mov     [errno], EDOM                       ; domain error
  336.     .endif
  337.     .if zero?    ;je      @@zero                              ; jump if zero
  338.       mov     [errno], ERANGE                     ; range error
  339.     .endif
  340.  
  341.     fld1                                        ; load 1
  342.     fxch    st(1)                               ; xchange it with value
  343.     fyl2x                                       ; calc y=log2(x)
  344.  
  345.     RETURN
  346. log2 ENDP
  347.  
  348. pow PROC, val:REAL8, power:REAL8
  349.     mov errno,0
  350.  
  351.     fld val
  352.     fcomp _ZERO  
  353.     fstsw ax
  354.     fwait
  355.     sahf
  356.     .if zero?
  357.       fld power
  358.       fcomp _ZERO
  359.       fstsw ax
  360.       fwait
  361.       sahf
  362.       .if zero?      ;this is ANSI C specs
  363.         fld1   ;load one!  (in reality 0**0 is INF - o well)
  364.         RETURN
  365.       .endif
  366.       fldz     ;0**power = 0 always
  367.       RETURN
  368.     .endif
  369.     fld power
  370.     fcomp _ZERO
  371.     fstsw ax
  372.     fwait
  373.     sahf
  374.     .if zero?      ;this is ANSI C specs
  375.       fld1   ;load one!
  376.       RETURN
  377.     .endif
  378.  
  379.     callp   log,val                         ; calculate log of val
  380.     LOADF
  381.  
  382.     fld power                               ; load power
  383.  
  384.     fmulp   st(1), st(0)                        ; multiply them
  385.     fstp    result                              ; save result
  386.  
  387.     callp   exp,result                          ; calculate exp func of result
  388.     LOADF
  389.     CHKF          ;setup error codes
  390.  
  391.     RETURN
  392. pow  ENDP
  393.  
  394. sqrt PROC, val:REAL8
  395.     mov     [errno], 0                          ; clear matherror
  396.     fld     val                                 ; load val
  397.     ftst                                        ; compare with zero
  398.     fstsw   ax                                  ; save status word in AX
  399.     fwait                                       ; wait this shit be idle
  400.     sahf                                        ; load flags with it
  401.     .if carry?                                  ; jump if value < 0
  402.       mov     [errno], EDOM                       ; uh-oh. val < 0 = domain err!
  403.       fsqrt     ;will return -NAN                 ; square root of st(0)
  404.       fabs      ;make sure it's +NAN
  405.     .else
  406.       fsqrt                                       ; square root of st(0)
  407.     .endif
  408.  
  409.     RETURN
  410. sqrt ENDP
  411.  
  412.  
  413.